home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / packages / saveconf.el < prev    next >
Encoding:
Text File  |  1995-04-26  |  10.4 KB  |  281 lines
  1. ;;; Save Emacs buffer and window configuration between editing sessions.
  2. ;;; Copyright (C) 1987, 1988, 1989 Kyle E. Jones
  3. ;;;
  4. ;;; This program is free software; you can redistribute it and/or modify
  5. ;;; it under the terms of the GNU General Public License as published by
  6. ;;; the Free Software Foundation; either version 1, or (at your option)
  7. ;;; any later version.
  8. ;;;
  9. ;;; This program is distributed in the hope that it will be useful,
  10. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. ;;; GNU General Public License for more details.
  13. ;;;
  14. ;;; A copy of the GNU General Public License can be obtained from the
  15. ;;; program's author (send electronic mail to kyle@cs.odu.edu) or from
  16. ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
  17. ;;; 02139, USA.
  18. ;;;
  19. ;;; Send bug reports to kyle@cs.odu.edu.
  20.  
  21. ;; This package of functions gives Emacs the ability to remember which
  22. ;; files were being visited, the windows that were on them, and the
  23. ;; value of point in their buffers the last Emacs session in the same
  24. ;; directory.  This is an emulation of an old Gosling Emacs feature.
  25. ;;
  26. ;; The relevant commands are save-context and recover-context.
  27. ;;
  28. ;; Most of the time you'll want an Emacs session's context saved even if
  29. ;; you choose not to recover it later.  To avoid having to manually
  30. ;; M-x save-context at each emacs exit, put the line:
  31. ;;    (setq auto-save-and-recover-context t)
  32. ;; in your .emacs or in default.el in the lisp directory of the Emacs
  33. ;; distribution.  The context will then automatically be saved when
  34. ;; Emacs exits.
  35. ;;
  36. ;; By default only the contexts of visible buffers (buffers with windows
  37. ;; on them) are saved.  Setting the variable save-buffer-context to t
  38. ;; causes the contexts of all buffers to be saved.
  39. ;;
  40. ;; Put this file in the "lisp" directory of the emacs distribution in a
  41. ;; file called saveconf.el.  Byte-compile it.
  42. ;;
  43. ;; There are two ways to use this package.
  44. ;;   1) Put the line
  45. ;;       (require 'saveconf)
  46. ;;      in the file site-init.el in the lisp directory of the Emacs
  47. ;;      directory and rebuild Emacs.  If you get the "Pure Lisp storage
  48. ;;      exhausted" error message when rebuilding Emacs, increase PURESIZE
  49. ;;      in src/config.h by about 30000 bytes and try again.  It's almost
  50. ;;      certain that this will happen to you so you might as well increase
  51. ;;      PURESIZE beforehand.
  52. ;;
  53. ;;      This is the preferred mode of operation because it allows the
  54. ;;      package to become part of Emacs' startup sequence and automatically
  55. ;;      restore context in a directory if Emacs is invoked without any
  56. ;;      command line arguments.
  57. ;;
  58. ;;   2) Put these lines
  59. ;;       (require 'saveconf)
  60. ;;       (if (null (cdr command-line-args))
  61. ;;           (setq inihibit-startup-message (recover-context)))
  62. ;;      at the end of your .emacs file or the default.el file in the
  63. ;;      lisp directory of the Emacs distribution.  This causes the
  64. ;;      context saved in the current directory to be recovered whenever
  65. ;;      Emacs is invoked without any arguments.
  66.  
  67. (provide 'saveconf)
  68.  
  69. (defconst save-context-version "Norma Jean"
  70.   "A unique string which is placed at the beginning of every saved context
  71. file.  If the string at the beginning of the context file doesn't match the
  72. value of this variable the `recover-context' command will ignore the file's
  73. contents.")
  74.  
  75. (defvar auto-save-and-recover-context nil
  76.   "*If non-nil the `save-context' command will always be run before Emacs is
  77. exited.  Also upon Emacs startup, if this variable is non-nil and Emacs is
  78. passed no command line arguments, `recover-context' will be run.")
  79.  
  80. (defvar save-buffer-context nil
  81.   "*If non-nil the `save-context' command will save the context
  82. of buffers that are visiting files, as well as the contexts of buffers
  83. that have windows.")
  84.  
  85. (defvar save-context-predicate
  86.   (function (lambda (w)
  87.           (and (buffer-file-name (window-buffer w))
  88.            (not (string-match "^\\(/usr\\)?/tmp/"
  89.                       (buffer-file-name (window-buffer w)))))))
  90.   "*Value is a predicate function which determines which windows' contexts
  91. are saved.  When the `save-context' command is invoked, this function will
  92. be called once for each existing Emacs window.  The function should accept
  93. one argument which will be a window object, and should return non-nil if
  94. the window's context should be saved.")
  95.  
  96.  
  97. ;; kill-emacs' function definition must be saved
  98. (if (not (fboundp 'just-kill-emacs))
  99.     (fset 'just-kill-emacs (symbol-function 'kill-emacs)))
  100.  
  101. ;; Make Emacs call recover-context at startup if appropriate.
  102. (setq top-level
  103.       (list 'let '((starting-up (not command-line-processed)))
  104.         (list 'prog1
  105.           top-level
  106.           '(and starting-up auto-save-and-recover-context
  107.             (null (cdr command-line-args)) (recover-context)))))
  108.  
  109. (defun kill-emacs (&optional query)
  110.   "End this Emacs session.
  111. Prefix ARG or optional first ARG non-nil means exit with no questions asked,
  112. even if there are unsaved buffers.  If Emacs is running non-interactively
  113. and ARG is an integer, then Emacs exits with ARG as its exit code.
  114.  
  115. If the variable `auto-save-and-restore-context' is non-nil,
  116. the function save-context will be called first."
  117.   (interactive "P")
  118.   ;; check the purify flag.  try to save only if this is a dumped Emacs.
  119.   ;; saving context from a undumped Emacs caused a NULL pointer to be
  120.   ;; referenced through.  I'm not sure why.
  121.   (if (and auto-save-and-recover-context (null purify-flag))
  122.       (save-context))
  123.   (just-kill-emacs query))
  124.  
  125. (defun save-context ()
  126.   "Save context of all Emacs windows (files visited and position of point).
  127. The information goes into a file called .emacs_<username> in the directory
  128. where the Emacs session was started.  The context can be recovered with the
  129. `recover-context' command, provided you are in the same directory where
  130. the context was saved.
  131.  
  132. If the variable `save-buffer-context' is non-nil, the context of all buffers
  133. visiting files will be saved as well.
  134.  
  135. Window sizes and shapes are not saved, since these may not be recoverable
  136. on terminals with a different number of rows and columns."
  137.   (interactive)
  138.   (condition-case error-data
  139.       (let (context-buffer mark save-file-name)
  140.     (setq save-file-name (concat (original-working-directory)
  141.                      ".emacs_" (user-login-name)))
  142.     (if (not (file-writable-p save-file-name))
  143.         (if (file-writable-p (original-working-directory))
  144.         (error "context is write-protected, %s" save-file-name)
  145.           (error "can't access directory, %s"
  146.              (original-working-directory))))
  147.     ;;
  148.     ;; set up a buffer for the saved context information
  149.     ;; Note that we can't set the visited file yet, because by
  150.     ;; giving the buffer a file to visit we are making it
  151.     ;; eligible to have it's context saved.
  152.     ;;
  153.     (setq context-buffer (get-buffer-create " *Context Info*"))
  154.     (set-buffer context-buffer)
  155.     (erase-buffer)
  156.     (set-buffer-modified-p nil)
  157.     ;;
  158.     ;; record the context information
  159.     ;;
  160.     (mapcar
  161.      (function
  162.       (lambda (w)
  163.         (cond ((funcall save-context-predicate w)
  164.            (prin1 (buffer-file-name (window-buffer w)) context-buffer)
  165.            (princ " " context-buffer)
  166.            (prin1 (window-point w) context-buffer)
  167.            (princ "\n" context-buffer)))))
  168.      (window-list))
  169.     
  170.     ;;
  171.     ;; nil is the data sentinel.  We will insert it later if we
  172.     ;; need it but for now just remember where the last line of
  173.     ;; window context ended.
  174.     ;;
  175.     (setq mark (point))
  176.  
  177.     ;;
  178.     ;; If `save-buffer-context' is non-nil we save buffer contexts.
  179.     ;;
  180.     (if save-buffer-context
  181.         (mapcar
  182.          (function
  183.           (lambda (b)
  184.         (set-buffer b)
  185.         (cond (buffer-file-name
  186.                (prin1 buffer-file-name context-buffer)
  187.                (princ " " context-buffer)
  188.                (prin1 (point) context-buffer)
  189.                (princ "\n" context-buffer)))))
  190.          (buffer-list)))
  191.  
  192.     ;;
  193.     ;; If the context-buffer contains information, we add the version
  194.     ;;   string and sentinels, and write out the saved context.
  195.     ;; If the context-buffer is empty, we don't create a file at all.
  196.     ;; If there's an old saved context in this directory we attempt
  197.     ;;   to delete it.
  198.     ;;
  199.     (cond ((buffer-modified-p context-buffer)
  200.            (set-buffer context-buffer)
  201.            (setq buffer-offer-save nil)
  202.            ;; sentinel for EOF
  203.            (insert "nil\n")
  204.            ;; sentinel for end of window contexts
  205.            (goto-char mark)
  206.            (insert "nil\n")
  207.            ;; version string
  208.            (goto-char (point-min))
  209.            (prin1 save-context-version context-buffer)
  210.            (insert "\n\n")
  211.            ;; so kill-buffer won't need confirmation later
  212.            (set-buffer-modified-p nil)
  213.            ;; save it
  214.            (write-region (point-min) (point-max) save-file-name
  215.                  nil 'quiet))
  216.           (t (condition-case data
  217.              (delete-file save-file-name) (error nil))))
  218.  
  219.     (kill-buffer context-buffer))
  220.     (error nil)))
  221.  
  222. (defun recover-context ()
  223.   "Recover an Emacs context saved by `save-context' command.
  224. Files that were visible in windows when the context was saved are visited and
  225. point is set in each window to what is was when the context was saved."
  226.   (interactive)
  227.   (condition-case error-data
  228.       ;;
  229.       ;; Set up some local variables.
  230.       ;;
  231.       (let (sexpr context-buffer recover-file-name)
  232.     (setq recover-file-name (concat (original-working-directory)
  233.                     ".emacs_" (user-login-name)))
  234.     (if (not (file-readable-p recover-file-name))
  235.         (error "can't access context, %s" recover-file-name))
  236.     ;;
  237.     ;; create a temp buffer and copy the saved context into it.
  238.     ;;
  239.     (setq context-buffer (get-buffer-create " *Recovered Context*"))
  240.     (set-buffer context-buffer)
  241.     (erase-buffer)
  242.     (insert-file-contents recover-file-name nil)
  243.     ;; so kill-buffer won't need confirmation later
  244.     (set-buffer-modified-p nil)
  245.     ;;
  246.     ;; If it's empty forget it.
  247.     ;;
  248.     (if (zerop (buffer-size))
  249.         (error "context file is empty, %s" recover-file-name))
  250.     ;;
  251.     ;; check the version and make sure it matches ours
  252.     ;;
  253.     (setq sexpr (read context-buffer))
  254.     (if (not (equal sexpr save-context-version))
  255.         (error "version string incorrect, %s" sexpr))
  256.     ;;
  257.     ;; Recover the window contexts
  258.     ;;
  259.     (while (setq sexpr (read context-buffer))
  260.       (select-window (get-largest-window))
  261.       (if (buffer-file-name)
  262.           (split-window))
  263.       (other-window 1)
  264.       (find-file sexpr)
  265.       (goto-char (read context-buffer)))
  266.     ;;
  267.     ;; Recover buffer contexts, if any.
  268.     ;;
  269.     (while (setq sexpr (read context-buffer))
  270.       (set-buffer (find-file-noselect sexpr))
  271.       (goto-char (read context-buffer)))
  272.     (bury-buffer "*scratch*")
  273.     (kill-buffer context-buffer)
  274.     t )
  275.     (error nil)))
  276.      
  277. (defun original-working-directory ()
  278.   (save-excursion
  279.     (set-buffer (get-buffer-create "*scratch*"))
  280.     default-directory))
  281.